home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 167 / pascal / desktop.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-19  |  8.7 KB  |  329 lines
  1. Program DESKTOP_PRG(Input,Output);
  2. Label
  3.   9999;
  4. Const
  5.   ProgramTitle = 'DESKTOP.PRG (FreeWare) Version 1.01';
  6.   ProgramInfo  = '  (the DESKTOP.INF setup program)';
  7.   Desktop      = 'A:\DESKTOP.INF';
  8.   DesktopLow   = 'A:\DESKTOP.INL'   { Also checkpresent uses 'L' };
  9.   DesktopMed   = 'A:\DESKTOP.INM'   { Also checkpresent uses 'M' };
  10.   DesktopHi    = 'A:\DESKTOP.INH'   { Also checkpresent uses 'H' };
  11.   StringMax    = 80;
  12.   C_StringMax  = 81;
  13. Type
  14.   NameString = String[StringMax];
  15.   DeskTopSet = Set Of 0..3;
  16. Var
  17.   CurrentRes  : Integer;
  18.   CurrentInf  : Integer;
  19.   Answer      : Integer;
  20.   FromFile    : NameString;
  21.   Line        : NameString;
  22.   DeskPresent : DeskTopSet;
  23.  
  24. Function CRawCIn:Long_Integer;
  25. GEMDOS(7);
  26.  
  27. Function GetRez:Integer;
  28. XBIOS(4);
  29.  
  30. Function Rename(FromFile,ToFile:NameString):Integer;
  31. Type
  32.   FName = Packed Array[1..C_StringMax] Of Char;
  33. Var
  34.   FFile : FName;
  35.   TFile : FName;
  36.   I, J  : Integer;
  37.  
  38.   Function FRename(Dummy:Integer; Var OldName,NewName:FName):Integer;
  39.   GEMDOS(86);
  40.  
  41. Begin
  42.   For I:=1 To Length(FromFile) Do Begin
  43.     FFile[I]:=FromFile[I];
  44.   End;
  45.   FFile[Length(FromFile)+1]:=Chr(0);
  46.   For I:=1 To Length(ToFile) Do Begin
  47.     TFile[I]:=ToFile[I];
  48.   End;
  49.   TFile[Length(ToFile)+1]:=Chr(0);
  50.   Rename:=FRename(J,FFile,TFile);
  51. End;
  52.  
  53. Procedure OSS_Message;
  54. Begin
  55.   Write(Output,Chr(27),'E') (* Clear Screen *);
  56.   Writeln(Output,Chr(27),'Y  ',ProgramTitle);
  57.   Writeln(Output,ProgramInfo);
  58.   Writeln(Output);
  59.   Writeln(Output,'     Portions of this product are');
  60.   Writeln(Output,'     Copyright © 1986, OSS and CCD.');
  61.   Writeln(Output,'     Used by Permission of OSS.');
  62.   Writeln(Output);
  63.   Writeln(Output,'Copyright © 1987,  OIIHOB Computing');
  64.   Writeln(Output,'                   6557 Hokah Drive');
  65.   Writeln(Output,'                   Lino Lakes, MN 55014');
  66.   Writeln(Output,Chr(27),'Y. ');
  67. End;
  68.  
  69. Procedure RenameDeskTop(FromFile, ToFile : NameString);
  70. Var
  71.   Result   : Integer;
  72. Begin
  73.   Writeln(Output,Chr(27),'Y. ');
  74.   Writeln(Output,'Renaming ',Desktop,' to be');
  75.   Writeln(Output,'         ',FromFile);
  76.   Result:=Rename(Desktop,FromFile);
  77.   If Result<>0 Then Begin
  78.     Writeln(Output,' Returned ERROR CODE of: ',Result:0);
  79.   End;
  80.   Writeln(Output);
  81.   Writeln(Output,'Renaming ',ToFile,' to be');
  82.   Writeln(Output,'         ',Desktop);
  83.   Result:=Rename(ToFile,Desktop);
  84.   If Result<>0 Then Begin
  85.     Writeln(Output,' Returned ERROR CODE of: ',Result:0);
  86.   End;
  87.   Writeln(Output);
  88. End;
  89.  
  90. Procedure CheckDesk(Var SetPresent:DeskTopSet);
  91. Type
  92.   Path     = Packed Array[1..80] Of Char;
  93.   Name     = Packed Array[1..14] Of Char;
  94.   String80 = String[80];
  95.   Entry    = Packed Record
  96.                Filler_1  : Packed Array[0..19] Of Byte;
  97.                Filler_2  : Byte;
  98.                Attribute : Byte;
  99.                DirTime   : Integer;
  100.                DirDate   : Integer;
  101.                Length    : Long_Integer;
  102.                TheName   : Name;
  103.              End;
  104. Var
  105.   SubDirectory : Path;
  106.   SearchPath   : Path;
  107.   DTA_Buffer   : Entry;
  108.   FileName     : Name;
  109.   Drive        : Integer;
  110.   Temp         : Integer;
  111.   LTemp        : Long_Integer;
  112.   S            : String80;
  113.  
  114. Function DSetDrv(Drive:Integer):Long_Integer; GEMDOS($0E);
  115.  
  116. Function DGetDrv:Integer; GEMDOS($19);
  117.  
  118. Function FSetDTA(Var Buffer:Entry):Integer; GEMDOS($1A);
  119.  
  120. Function DSetPath(Var Path_Buffer:Path):Integer; GEMDOS($3B);
  121.  
  122. Function DGetPath(Var Path_Buffer:Path):Integer; GEMDOS($47);
  123.  
  124. Function FSFirst(Var SearchMask:Path; Attr:Integer):Integer; GEMDOS($4E);
  125.  
  126. Function FSNext:Integer; GEMDOS($4F);
  127.  
  128. Procedure Assign(Var A:Path; S:String80);
  129. Var I:Integer;
  130. Begin
  131.   For I:=1 to Length(S) Do
  132.      A[I]:=S[I];
  133.   For I:=Length(S)+1 To 80 Do
  134.      A[I]:=' ';
  135. End;
  136.  
  137. Begin
  138.   SetPresent:=[];
  139.   Drive:=DGetDrv;
  140.   LTemp:=DSetDrv(0);
  141.   Assign(SubDirectory,Chr(0));
  142.   Temp:=DSetPath(SubDirectory);
  143.   Temp:=FSetDTA(DTA_Buffer);
  144.   Assign(SearchPath,'DESKTOP.IN?');
  145.   DTA_Buffer.TheName:='              ';
  146.   Temp:=FSFirst(SearchPath,0);
  147.   While Temp=0 Do Begin
  148.     With DTA_Buffer Do Begin
  149.       Case TheName[11] Of
  150.         'L': SetPresent:=SetPresent+[0];
  151.         'M': SetPresent:=SetPresent+[1];
  152.         'H': SetPresent:=SetPresent+[2];
  153.         'F': SetPresent:=SetPresent+[3];
  154.         Otherwise: ;
  155.       End;
  156.       TheName:='              ';
  157.     End;
  158.     Temp:=FSNext;
  159.   End;
  160.   LTemp:=DSetDrv(Drive);
  161. End;
  162.  
  163. Function CurrentDeskInf:Integer;
  164. Var
  165.   Desk   : Text;
  166.   C1, C2 : Char;
  167.   I1, I2 : Integer;
  168.   Line   : NameString;
  169. Begin
  170.   Reset(Desk,Desktop);
  171.   Read(Desk,C1, C2);
  172.   While Not ((C1='#') And (C2='E')) Do Begin
  173.     Readln(Desk,Line);
  174.     Read(Desk,C1,C2);
  175.   End;
  176.   While Desk^=' ' Do Get(Desk);
  177.   While Desk^<>' ' Do Get(Desk);
  178.   While Desk^=' ' Do Get(Desk);
  179.   Read(Desk,C1,C2);
  180.   If C1 in ['A'..'F'] Then
  181.     I1:=Ord(C1)-Ord('A')+10;
  182.   If C1 in ['a'..'f'] Then
  183.     I1:=Ord(C1)-Ord('a')+10;
  184.   If C1 in ['0'..'9'] Then
  185.     I1:=Ord(C1)-Ord('0');
  186.   If C2 in ['A'..'F'] Then
  187.     I2:=Ord(C2)-Ord('A')+10;
  188.   If C2 in ['a'..'f'] Then
  189.     I2:=Ord(C2)-Ord('a')+10;
  190.   If C2 in ['0'..'9'] Then
  191.     I2:=Ord(C2)-Ord('0');
  192.   CurrentDeskInf:=16*I1+I2-1;
  193. End;
  194.  
  195. Function GetResolution:Integer;
  196. Const
  197.   UpKey     = $48;
  198.   LeftKey   = $4B;
  199.   RightKey  = $4D;
  200.   DownKey   = $50;
  201.   EnterKey  = $72;
  202.   ReturnKey = $1C;
  203.   SpaceBar  = $39;
  204.   MKey      = $32;
  205.   LKey      = $26;
  206. Var
  207.   Convert   : Packed Record Case Integer Of
  208.                 0: (L : Long_Integer);
  209.                 1: (W : Packed Array[1..2] Of Integer);
  210.               End;
  211.   Continue  : Boolean;
  212.   Mode      : Integer;
  213.  
  214.   Procedure DisplayModes;
  215.   Begin
  216.     Writeln(Output,Chr(27),'Y+ What is your desired screen resolution?');
  217.     If Mode=0 Then
  218.       Writeln(Output,Chr(27),'Y,)',Chr(27),'p LOW    ',Chr(27),'q',
  219.                                  Chr(27),'Y-) MEDIUM ')
  220.     Else
  221.       Writeln(Output,Chr(27),'Y,)',Chr(27),'q LOW    ',
  222.                      Chr(27),'Y-)',Chr(27),'p MEDIUM ',Chr(27),'q');
  223.     Writeln(Output);
  224.     Writeln(Output);
  225.   End;
  226.  
  227. Begin
  228.   Mode:=CurrentInf;
  229.   If Mode=2 Then Begin
  230.     Mode:=1;
  231.   End;
  232.   Continue:=True;
  233.   While Continue Do Begin
  234.     DisplayModes;
  235.     Convert.L:=CRawCIn;
  236.     Case Convert.W[1] Of
  237.       EnterKey,
  238.       ReturnKey: Continue:=False;
  239.       UpKey,
  240.       LeftKey,
  241.       DownKey,
  242.       RightKey,
  243.       SpaceBar: Mode:=(Mode+1) Mod 2;
  244.       LKey: Begin Mode:=0; DisplayModes; Continue:=False; End;
  245.       MKey: Begin Mode:=1; DisplayModes; Continue:=False; End;
  246.       Otherwise: Writeln(Output,Chr(7),Chr(7),Chr(7));
  247.     End;
  248.   End;
  249.   GetResolution:=Mode;
  250. End;
  251.  
  252. Procedure ErrorOff;
  253. Var
  254.   Key : Long_Integer;
  255. Begin
  256.   Writeln(Output,'Pausing due to error!');
  257.   Writeln(Output,'  Hit any key to coninue...');
  258.   Key:=CRawCIn;
  259.   Goto 9999;
  260. End;
  261.  
  262. Procedure DoRenameDeskTop(FromFile, ToFile : NameString);
  263. Var
  264.   Res : Integer;
  265. Begin
  266.   If Not (Answer In DeskPresent) Then Begin
  267.     Writeln(Output,'*ERROR your disk does not contain ',FromFile);
  268.     Writeln(Output,'  You will be booting without a DESKTOP.INF');
  269.     Writeln(Output,'  Please arrange desktop snd then save it!');
  270.     ErrorOff;
  271.   End;
  272.   RenameDeskTop(FromFile,ToFile);
  273. End;
  274.  
  275. Begin
  276.   OSS_Message;
  277.   CheckDesk(DeskPresent);
  278.   If Not (3 In DeskPresent) Then Begin
  279.     Writeln(Output,'*ERROR your disk does not contain');
  280.     Writeln(Output,'  DESKTOP.INF');
  281.     ErrorOff;
  282.   End;
  283.   CurrentRes:=GetRez;
  284.   CurrentInf:=CurrentDeskInf;
  285.   Case CurrentInf Of
  286.     0: FromFile:=DesktopLow;
  287.     1: FromFile:=DesktopMed;
  288.     2: FromFile:=DesktopHi;
  289.     Otherwise: FromFile:='A:\_-_-_-_-.INF';
  290.   End;
  291.   If DeskPresent = [0, 1, 2, 3] Then Begin
  292.     Writeln(Output);
  293.     Writeln(Output,'*ERROR you have the files of:');
  294.     Writeln(Output,'   DESKTOP.INF       DESKTOP.INL');
  295.     Writeln(Output,'   DESKTOP.INM  and  DESKTOP.INH');
  296.     Writeln(Output,'Therefore, renaming can not be performed.');
  297.     Writeln(output);
  298.     ErrorOff;
  299.   End;
  300.   If CurrentInf In DeskPresent Then Begin
  301.     Writeln(Output);
  302.     Writeln(Output,'*ERROR your DESKTOP.INF should be');
  303.     Writeln(Output,'   renamed to ',FromFile);
  304.     Writeln(Output,'  which exists on your disk!');
  305.     Writeln(Output,'Therefore, renaming can not be performed.');
  306.     Writeln(output);
  307.     ErrorOff;
  308.   End;
  309.   Case CurrentRes Of
  310.     0,
  311.     1: Begin
  312.          Answer:=GetResolution;
  313.          If (Answer=0) And (CurrentInf<>0) Then Begin
  314.            DoRenameDeskTop(FromFile, DeskTopLow);
  315.          End;
  316.          If (Answer=1) And (CurrentInf<>1) Then Begin
  317.            DoRenameDeskTop(FromFile, DeskTopMed);
  318.          End;
  319.        End;
  320.     2: Begin
  321.          Answer:=2;
  322.          If CurrentInf<>2 Then Begin
  323.            DoRenameDeskTop(FromFile, DeskTopHi);
  324.          End;
  325.        End;
  326.   End;
  327.   9999: Writeln(Output,'End DESKTOP.PRG');
  328. End.
  329.